home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / wildcat / qwkhold1.zip / QWK2MAKE.WCC < prev    next >
Text File  |  1996-05-13  |  28KB  |  594 lines

  1. 'QWK2MAKE.WCC by James Mardis  (FidoNet 1:322/746)  5/7/96
  2. '
  3. '  This program makes QWK Mail made for callers to pick up later.
  4. '  It is used with the companion programs LOGON2.WCC and QWK2HOLD.WCC.
  5. '  This program is intended to be run from a DOS BATCH program immediately
  6. '  after your mail has been processed.
  7. '
  8. '  A short batch program entry could look like the following:
  9. '
  10. '                           C:
  11. '                           CD\WILDCAT
  12. '                           ECHO Turn on inbound mail flag > QWK2MA1.FLG
  13. '        Manditory line --> SET WCPORTID=0
  14. '        Manditory line --> WILDCAT /R QWK2MAKE.WCX
  15. '
  16. '
  17. 'The configuration file, QWK2HOLD.CFG breaks down as follows:
  18. 'Line #1, Complete PathName where WCMAIL QWK stores mail packets,
  19. '         such as C:\WILDCAT\MAIL\QWK\
  20. '
  21. 'Line #2, File area number for QWK Mail that was choosen in the Makewild
  22. '         QWK Mail area.
  23. '
  24. 'Line #3, Complete PathName where QWK2 can store all user mail packets.
  25. '
  26. 'Line #4, Valid values are COMMENT(1) thru COMMENT(5) exactly as shown.
  27. '         The right and left parentheses around the number are
  28. '         manditory.
  29. '
  30. '         The actual value found in the user's COMMENT(?) field will
  31. '         contain either QWK2 ON  XX or QWK2 OFF XX where XX equals
  32. '         the number of mail packets that are currently in storage.
  33. '         The XX field must begin at character 10 in the comment field.
  34. '
  35. 'Line #5, Security Profile #1 to exclude from operating this program.
  36. '         I use this to bar NEWUSER from this program
  37. '         while allowing them access to other WCX programs.
  38. '         If not used set it to NO SEC1.
  39. '
  40. 'Line #6, Security Profile #2 to exclude from operating this program.
  41. '         If not used set it at NO SEC2.
  42. '
  43. 'Line #7  Maximum number of QWK packets a caller can have waiting for pickup.
  44. '         Valid values are 1 to 26.
  45. '
  46. 'Line #8  Maximum number of days to keep stored QWK packets.
  47. '         Valid values are 1 to 365.
  48. '
  49. 'Line #9  Maximum allowed storage space for user packets in bytes, but
  50. '         a minimum of 1 packet is allowed regardless of this value.
  51. '         Valid values are 1 to 2147483647, this is in bytes like
  52. '         what you see when listing a DOS directory from DOS.
  53. '
  54. 'Line #10 Conference number where user messages are to be sent.
  55. '         Messages will be sent with the Private flag turned on.
  56. '
  57. 'Line #11 Prompt colors normal for Text and Background, leave off @ symbols.
  58. '         Default two character code is 0E.
  59. '
  60. 'Line #12 Prompt colors normal for Highlighted Text.
  61. '         Default two character code is 0B.
  62. '
  63. 'Line #13 Prompt colors normal for Packet size and elsewhere.
  64. '         Default two character code is 0C.
  65. '
  66. 'Line #14 Prompt colors normal for warning messages.
  67. '         Default two character code is 0E.
  68. '
  69. 'Line #15 Path to inbound mail flag,  Where to look for QWK2MA?.FLG.
  70. '
  71. 'Line #16 Text to display when Mail Flag #1 is found.
  72. '
  73. 'Line #17 Text to display when Mail Flag #2 is found.
  74. '
  75. 'Line #18 Text to display when Mail Flag #3 is found.
  76. '
  77. 'Line #19 Text to display when Mail Flag #4 is found.
  78. '
  79. 'Line #20 Text to display when Mail Flag #5 is found.
  80. '
  81. 'The first time this program is ever run it will move all packets found
  82. 'to the stored packet directory.
  83. '
  84. EnablePages Off              'Ignore pages until program ends.
  85. dim BadEnd as Integer        'Value to trigger program failure message.
  86. dim ChaStr1 as String        'Junk String Variable, re-used at will.
  87. dim ChaStr2 as String        'Junk String Variable, re-used at will.
  88. dim CurCode as Date          'Current Date while in ddmmyyyy format.
  89. dim CurDate as Integer       'Current date coded in DOS format.
  90. dim CurDay as String         'Current Day while code is run.
  91. dim CurMonth as String       'Current Month while code is run.
  92. dim CurYear as String        'Current Year while code is run.
  93. dim FileDos as Word          'File date in DOS code format.
  94. dim FileNm2 as String        'Used to Open assorted files.
  95. dim FileSearch as SearchRec  'Search record array for file info.
  96. dim FileSize as Long         'Current file size.
  97. dim FindQWK as Integer       '"For" loop counter vailable.
  98. dim FindUser as Integer      '"For" loop counter variable.
  99. dim FlagChk as Integer       'User QWK2 ON/OFF flag variable.
  100. dim MailProc1 as String      'QWK.CFG #16, Prompt for mail flag #1
  101. dim MailProc2 as String      'QWK.CFG #17, Prompt for mail flag #2
  102. dim MailProc3 as String      'QWK.CFG #18, Prompt for mail flag #3
  103. dim MailProc4 as String      'QWK.CFG #19, Prompt for mail flag #4
  104. dim MailProc5 as String      'QWK.CFG #20, Prompt for mail flag #5
  105. dim MaxAge as Integer        'QWK2HOLD.CFG #8, Maximum # of days packets kept.
  106. dim MaxPacket as Integer     'QWK2HOLD.CFG #7, Maximum allowed QWK packets.
  107. dim MaxSize as Long          'QWK2HOLD.CFG #9, Maximum size of all packets.
  108. dim MsgHd as MessageHeader   'Used to send messages.
  109. dim MsgPlace as Integer      'QWK2HOLD.CFG #10, Conference where messages go.
  110. dim NewFile as String        'New QWK file name.
  111. dim NodeRec as NodeInfoRecord'Array to contain current node being checked.
  112. dim NumInt1 as Integer       'Junk Integer Variable, re-used at will.
  113. dim NumInt2 as Integer       'Junk Integer Variable, re-used at will.
  114. dim OldAge as Integer        'Oldest number of packet days in existance.
  115. dim OldFile as String        'Old QWK file name.
  116. dim UserOnline as Boolean    'Is user Online somewhere, if True (-1) or False (0).
  117. dim P1 as String             'QWK.CFG #11, Prompt #1 Color.
  118. dim P2 as String             'QWK.CFG #12, Prompt #2 Color.
  119. dim P3 as String             'QWK.CFG #13, Prompt #3 Color.
  120. dim P4 as String             'QWK.CFG #14, Prompt #4 Color.
  121. dim QWKAge as Integer        'Current age of the packet in days.
  122. dim QWKFlag as String        'QWK2HOLD.CFG #4, QWK search variable.
  123. dim QWKInbound as String     'QWK2HOLD.CFG #15, Path to mail flag.
  124. dim QWKLocal as String       'Path where Sysop's local QWK packets wind up.
  125. dim QWKRoute as String       'QWK2HOLD.CFG #3, Path to QWK2 mail packets.
  126. dim QWKTotal as Integer      'Total number of QWK packets for user.
  127. dim QWKLeft as Integer       'Total number of QWK packets a user has left.
  128. dim QWKSysop as String       'Path choosen by Sysop for local transfer.
  129. dim SecPro1 as String        'QWK2HOLD.CFG #5, Security Profile #1 restriction.
  130. dim SecPro2 as String        'QWK2HOLD.CFG #6, Security Profile #2 restriction.
  131. dim Size as Long             'Place to store total size of stored packets.
  132. dim UKey as String           'Used to determine user's choice.
  133. dim UserRec as UserRecord    'Create temporary array for user record.
  134. dim WCMailRoute as String    'QWK2HOLD.CFG #1, Path where WCMAIL stores packets.
  135. dim WCMailZip as Integer     'QWK2HOLD.CFG #2, File area number used in WCMAIL.
  136. dim QWKDown as String        'Used to determine if user wants to download QWK.
  137. '
  138. 'Time to read in the QWK2HOLD.CFG file.
  139. EnablePages Off ' Disable inbound page till program ends, resets at end.
  140. FileNm2 = ProgPath + "QWK2HOLD.CFG" 'QWK2HOLD.CFG is the configuration file.
  141. If Exists (FileNm2) then              'If QWK2HOLD.CFG exists, get data.
  142.   OPEN FileNm2 for Input as #1        'Open CFG file for reading.
  143.   If Not(local) Then CarrierCheck Off 'Ignore modem till entire file read.
  144.   LockFile (1,0,1)                    'Temporary file lock for multinode use.
  145.   Input #1, WCMailRoute  '#1,  Path where WCMAIL stores packets.
  146.   Input #1, WCMailZip    '#2,  File directory # from MAKEWILD(WCMAIL).
  147.   Input #1, QWKRoute     '#3,  Path to QWK Mail Packets.
  148.   Input #1, QWKFlag      '#4,  User QWK Comment(?) action.
  149.   Input #1, SecPro1      '#5,  Security Exclusion Value #1.
  150.   Input #1, SecPro2      '#6,  Security Exclusion Value #2.
  151.   Input #1, MaxPacket    '#7,  Maximum number of user QWK Packets.
  152.   Input #1, MaxAge       '#8,  Maximum # of days to keep stored packets.
  153.   Input #1, MaxSize      '#9,  Maximum size of storage for user packets.
  154.   Input #1, MsgPlace     '#10, Conference number where messages are to go.
  155.   Input #1, P1           '#11, Prompt color for normal text.
  156.   Input #1, P2           '#12, Prompt color for highlighted text.
  157.   Input #1, P3           '#13, Prompt color for Packet size.
  158.   Input #1, P4           '#14, Prompt color for Alert Messages.
  159.   Input #1, QWKInbound   '#15, Path to inbound mail flag, if mail processing.
  160.   Input #1, MailProc1    '#16, Mail Processing message #1.
  161.   Input #1, MailProc2    '#17, Mail Processing message #2.
  162.   Input #1, MailProc3    '#18, Mail Processing message #3.
  163.   Input #1, MailProc4    '#19, Mail Processing message #4.
  164.   Input #1, MailProc5    '#20, Mail Processing message #5.
  165.   UnlockFile (1,0,1)                  'Remove temporary file lock.
  166.   Close #1                            'Close the CFG file.
  167.   If Not(Local) Then CarrierCheck On  'File read, exit if carrier dropped.
  168. Else 'Go here if no CFG file is found.
  169.   BadEnd = 0 'Set up error message.
  170.   Goto Problem 'No CFG file was found, abort the program.
  171. End If 'End of LOGIN2.CFG input.
  172. 'Validate read QWK2HOLD.CFG file data.
  173. If WCMailRoute = "" Then
  174.   BadEnd = 1: Goto Problem 'WCMail Path missing, QWK2HOLD.CFG LINE #1.
  175. Else 'WCMailroute actually contains something.
  176.   WCMailRoute = Trim(UCase(WCMailRoute)) 'Make it Uppercase & Trim spaces.
  177.   If Mid(WCMailRoute,2,2) <> ":\" Then BadEnd = 1: Goto Problem
  178.   If Right(WCMailRoute,1) <> "\" Then 'Verify path ends in a backslash.
  179.     WCMailRoute = WCMailRoute + "\" 'Slash was added.
  180.   End If 'End of WCMailRoute slash check.
  181. End If 'End of WCMailRoute check.
  182. If QWKRoute = "" Then
  183.   BadEnd = 2: Goto Problem 'QWKRoute missing, QWK2HOLD.CFG LINE #2.
  184. Else 'QWKRoute actually contains something.
  185.   QWKRoute = Trim(UCase(QWKRoute)) 'Make it Uppercase & Trim spaces.
  186.   IF Mid(QWKRoute,2,2) <> ":\" Then BadEnd = 2: Goto Problem
  187.   IF Right(QWKRoute,1) <> "\" Then 'Verify path ends in backslash.
  188.     QWKRoute = QWKRoute + "\" 'Slash was added.
  189.   End If 'End of QWKRoute slash check.
  190. End If 'End of QWKRoute check.
  191. If QWKFlag = "" Then 'Does QWKFlag value exist in  the CFG file.
  192.   BadEnd = 3: Goto Problem 'QWKFlag missing, QWK2HOLD.CFG Line #3.
  193. Else 'QWKFlag actually contains something.
  194.   QWKFlag = UCase(QWKFlag) 'Make it Uppercase.
  195. End If' End of If QWKFlag.
  196. If SecPro1 = "" Then
  197.   SecPro1 = "NO SEC1" 'If no QWK2HOLD.CFG Line #5, set value.
  198. Else 'SecPro1 actually contains something.
  199.   SecPro1 = Trim(UCase(SecPro1)) 'Make it Uppercase & Trim spaces.
  200. End If
  201. If SecPro2 = "" Then
  202.   SecPro2 = "NO SEC2" 'If no QWK2HOLD.CFG Line #6, set value.
  203. Else 'SecPro2 actually contains something.
  204.   SecPro2 = Trim(UCase(SecPro2)) 'Make it Uppercase & Trim spaces.
  205. End If
  206. If QWKInbound = "" Then
  207.   BadEnd = 15: Goto Problem 'QWKInbound missing, QWK2HOLD.CFG LINE #15.
  208. Else 'QWKInbound actually contains something.
  209.   QWKInbound = Trim(UCase(QWKInbound)) 'Make it Uppercase & Trim spaces.
  210.   IF Mid(QWKInbound,2,2) <> ":\" Then BadEnd = 15: Goto Problem
  211.   IF Right(QWKInbound,1) <> "\" Then 'Verify path ends in backslash.
  212.     QWKInbound = QWKInbound + "\" 'Slash was added.
  213.   End If 'End of QWKInbound slash check.
  214. End If 'End of QWKInbound check.
  215. If MaxPacket <= 0 Then MaxPacket = 1 'Minimum value is 1.
  216. If MaxPacket >= 26 Then MaxPacket = 26 'Had to set a limit somewhere.
  217. If MaxAge <= 0 Then MaxAge = 0 'Keep the old packets forever.
  218. If MaxAge >= 365 Then MaxAge = 365 'Maximum life of packets is 1 year.
  219. If MaxSize <= 0 Then MaxSize = 2147483647 'If zero, set limit at highest.
  220. If MaxSize >= 2147483647 Then MaxSize = 2147483647 'Set maximum size limit.
  221. If P1 = "" or Len(P1) <> 2 Then 'Check prompt P1, normal text.
  222.   P1 = "@0E@" 'Set default prompt.
  223. Else P1 = "@" + UCase(P1) + "@"
  224. End If
  225. If P2 = "" or Len(P2) <> 2 Then 'Check prompt P2, highlighted text.
  226.   P2 = "@0F@" 'Set default prompt.
  227. Else P2 = "@" + UCase(P2) + "@"
  228. End If
  229. If P3 = "" or Len(P3) <> 2 Then 'Check prompt P3, Packet sizes.
  230.   P3 = "@0B@" 'Set default prompt.
  231. Else P3 = "@" + UCase(P3) + "@"
  232. End If
  233. If P4 = "" or Len(P4) <> 2 Then 'Check prompt P4, alert text.
  234.   P4 = "@0C@" 'Set default prompt.
  235. Else P4 = "@" + UCase(P4) + "@"
  236. End If
  237. CurrentDate(CurCode) 'Put date into CurDate.
  238. ChaStr1 = FormatDate(CurCode,"ddmmyyyy") 'Convert data into usable String.
  239. CurDay = Left(ChaStr1,2) 'Current Day established, used for CurDate.
  240. CurMonth = Mid(ChaStr1,3,2) 'Current Month established, used for CurDate.
  241. CurYear = Mid(ChaStr1,5,4) 'Current Year established, used for CurDate.
  242. 'Following line codes Wildcat! date to DOS style date for comparisons.
  243. CurDate = ((Val(CurYear)-1980)*512) + (Val(CurMonth)*32)+Val(CurDay)
  244. If WCMailRoute = QWKRoute Then
  245.   BadEnd = 3
  246.   ChaStr2 = "QWK2: Line #1 and Line #3 of QWK2HOLD.CFG MUST NOT be the same."
  247.   Print ChaStr2
  248.   ActivityLog ChaStr2
  249.   Goto Problem
  250. End If
  251. '>>>----> End of Configuration file and variable setup.
  252.  
  253. 'Clean up loop, in case caller lost carrier during downloading.
  254. NumInt1 = 0
  255. FindQWK = 0
  256. Do While FindQWK < MaxPacket
  257.   NewFile = QWKRoute + Str(User.UserID) + ".QW" + Chr(NumInt1 + 65)
  258.   OldFile = QWKRoute + Str(User.UserID) + ".QW" + Chr(FindQWK + 65)
  259.   If Exists(OldFile) Then 'OldFile already exists so go add one and go on.
  260.     FindQWK = FindQWK + 1
  261.     NumInt1 = NumInt1 + 1
  262.     If OldFile <> NewFile Then 'OldFile exists but does it match Newfile
  263.       Name OldFile as NewFile' Nope, rename Oldfile to fill gap.
  264.     End If 'End of If Oldfile <> Newfile
  265.   ELSE 'Oldfile was not found, increment and go thru loop again.
  266.     FindQWK = FindQWK + 1
  267.   End If 'End of If Exists(Oldfile)
  268. Loop
  269. QWKTotal = NumInt1
  270. 'End of Clean up loop
  271.  
  272. '>>>----> Find out which users want packets made for them.
  273. 'User Id's are what WCMAIL uses when it creates & names QWK mail packets.
  274. 'User Names or User ID's are WCMAIL variables used to make QWK packets.
  275. MorePrompt Off
  276. ChaStr2 = "QWK2: Packet Storage program has started"
  277. ActivityLog ChaStr2
  278. FileNm2 = ProgPath + "QWK2WAIT.BAT" 'Batch program of busy callers.
  279. If Exists (FileNm2) Then Del FileNm2 'Get rid of any old list.
  280. GetFirstUser(UserRec, 5)  'Go to top of file record, get first user.
  281. FlagChk = Val(Mid(QWKFlag,9,1))
  282. If UCase(Trim(Left(UserRec.Comment(FlagChk),8))) = "QWK2 ON" Then
  283.   UserOnline = False
  284.   Print P4;"QWK2 ON";P1;" ---> [";P2;UserRec.UserID;P1;"]   [";P3;UserRec.Name;P1;"].": Delay 4
  285.   Size = 0'Zero total packet size counter for user.
  286.   Gosub MainProg1 'Process user list and make packets if needed.
  287. ELSE
  288.   Print P1;"QWK2 OFF --> [";P2;UserRec.UserID;P1;"]   [";P3;UserRec.Name;P1;"]."
  289. End If
  290. Print "Finished checking first user record."
  291. While GetNextUser(UserRec, 5) 'Get the other User's information.
  292.   UserOnline = False
  293.   FlagChk = Val(Mid(QWKFlag,9,1))
  294.   If UCase(Trim(Left(UserRec.Comment(FlagChk),8))) = "QWK2 ON" Then
  295.     Print P4;"QWK2 ON";P1;" ---> [";P2;UserRec.UserID;P1;"]   [";P3;UserRec.Name;P1;"].": Delay 4
  296.     Gosub MainProg1 'Process user list and make packets if needed.
  297.   ELSE
  298.     Print P1;"QWK2 OFF --> [";P2;UserRec.UserID;P1;"]   [";P3;UserRec.Name;P1;"]."
  299.   End If
  300. Wend 'Locate next user's file and get information.
  301. Gosub CleanOut 'Remove Abandoned (user account deleted) or over age packets.
  302.  
  303. 'Delete any raised QWK2 mail flags.
  304. If Exists(QWKInbound + "QWK2MA1.FLG") Then Del QWKInbound + "QWK2MA1.FLG"
  305. If Exists(QWKInbound + "QWK2MA2.FLG") Then Del QWKInbound + "QWK2MA2.FLG"
  306. If Exists(QWKInbound + "QWK2MA3.FLG") Then Del QWKInbound + "QWK2MA3.FLG"
  307. If Exists(QWKInbound + "QWK2MA4.FLG") Then Del QWKInbound + "QWK2MA4.FLG"
  308. If Exists(QWKInbound + "QWK2MA5.FLG") Then Del QWKInbound + "QWK2MA5.FLG"
  309.  
  310. Finished:
  311. ChaStr2 = "QWK2: Packet Storage program has ended."' The program's over.
  312. ActivityLog ChaStr2
  313. MorePrompt On
  314. End
  315. '>>>----> Place for this program to end.
  316.  
  317. '>>>----> Start of MainProg1
  318. MainProg1:
  319. Print P1;"QWK2: ";P3;UserRec.Name;P1;" Verifying user account is not open.":Delay 2
  320. FileNm2 = ProgPath + "QWK2WAIT.BAT" 'Batch program of busy callers.
  321. NumInt1 = 0
  322. BadEnd = 0
  323. Size = 0
  324. While NumInt1 <= MaxNode
  325.  
  326. GetNodeInfo NodeRec, NumInt1
  327. If NodeRec.NodeStatus = 3 Then'Is node is online.
  328.   If Trim(NodeRec.CallersName) = UCase(Trim(UserRec.Name)) Then 'Was user on node.
  329.     UserOnline = True
  330.     'User is currently Online, add user to list of names for later processing.
  331.     OPEN FileNm2 for Append as #2 'Open QWK2WAIT.BAT file for writing.
  332.     LockFile (2,0,1) 'Temporary file lock for multinode use.
  333.     ChaStr1 = "WCMAIL " + UCase(Trim(UserRec.Name)) + " /PRESCAN" 'Shell Variables.
  334.     Print #2,ChaStr1
  335.     UnlockFile (2,0,1)
  336.     Close #2
  337.     ChaStr2 = "QWK2: "+UserRec.Name+"'s account was found open on node "+Str(NumInt1)+"."
  338.     ActivityLog ChaStr2
  339.     Print P1;"QWK2: ";P3;UserRec.Name;"'s";P1;" account found ";P4;"active";P1;" on Node #";P3;NumInt1;P1;"!": Delay 2
  340.     NumInt1 = MaxNode + 1
  341.   End If 'If Trim(NodeRec.CallersName).
  342. End If 'If (NodeRec.NodeStatus.
  343. NumInt1 = NumInt1 + 1
  344. Wend 'End of While loop
  345. NumInt1 = 0
  346. ChaStr2 = ""
  347. FileNm2 = ""
  348. Print P1;"QWK2: ";P3;UserRec.Name;P1;" Finished verifying account status.":Delay 2
  349. 'Begin processing user mail at this time.
  350. If UserOnline = True Then Return 'User Is online, so skip subroutine.
  351. '>>>----> First make sure user's packet(s) start with letter A & no gaps.
  352. '         Needed in case a user lost carrier during a QWK download.
  353. NumInt1 = 0
  354. FindQWK = 0
  355. Print P1;"QWK2: ";P3;UserRec.Name;P1;" Checking for existing and New packets."
  356. Do While FindQWK < MaxPacket
  357.   NewFile = QWKRoute + Str(UserRec.UserID) + ".QW" + Chr(NumInt1 + 65)
  358.   OldFile = QWKRoute + Str(UserRec.UserID) + ".QW" + Chr(FindQWK + 65)
  359.   If Exists(OldFile) Then 'OldFile already exists so go add one and go on.
  360.     FindQWK = FindQWK + 1
  361.     NumInt1 = NumInt1 + 1
  362.     If OldFile <> NewFile Then 'OldFile exists but does it match Newfile
  363.       Name OldFile as NewFile' Nope, rename Oldfile to fill gap.
  364.     End If 'End of If Oldfile <> Newfile
  365.   ELSE 'Oldfile was not found, increment and go thru loop again.
  366.   FindQWK = FindQWK + 1
  367.   End If 'End of If Exists(Oldfile)
  368. Loop
  369.  
  370. CLS
  371. Locate 8,1
  372. Print P1;"QWK2: ";P3;UserRec.Name;P1;" Checking storage depot."
  373. FindQWK = 0
  374. QWKTotal = 0
  375. OldAge = 0
  376. Size = 0
  377. Do While FindQWK < MaxPacket  'Start search for stored packets.
  378.   NewFile = QWKRoute + Str(UserRec.UserID) + ".QW" + Chr(QWKTotal + 65)
  379.   If Exists(NewFile) Then 'Checking for existing stored packet.
  380.     QWKTotal = QWKTotal + 1'Existing packet count incremented.
  381.     FindFirst(NewFile,0,FileSearch)
  382.     FileSize=FileSearch.Size
  383.     FileDos=FileSearch.DosDate
  384.     Size = Size + FileSearch.Size
  385.     MorePrompt Off
  386.     Locate 10,1
  387.     CLREOL
  388.     Print P1;"QWK2: ";P3;UserRec.Name;P1;" Last stored packet found was ";P2;FileSearch.Name;P1;"."
  389.     Print
  390.     Print P1;"Total Packets Found ......... ";
  391.     If QWKTotal > MaxPacket Then
  392.       Print P4;QWKTotal
  393.     Else
  394.       Print P2;QWKTotal
  395.     End If
  396.     Print P1;"Maximum # Packets Allowed ... ";P2;MaxPacket
  397.     CLREOL
  398.     Print P1;"Last Checked Packet Size .... ";P2;FileSize;P1;" Bytes"
  399.     Print P1;"Total Packet Storage ........ ";
  400.     If Size > MaxSize Then
  401.       Print P4;Size;P1;" Bytes"
  402.     Else
  403.       Print P2;Size;P1;" Bytes"
  404.     End If
  405.     Print P1;"Packet Storage Maximum ...... ";P2;MaxSize;P1;" Bytes"
  406.     CLREOL
  407.     Print P1;"Packet Age Maximum .......... ";P2;MaxAge;P1;" Day(s)"
  408.     If CurDate - FileDos > OldAge then OldAge = CurDate - FileDos
  409.     Print P1;"Oldest Packet Age was ....... ";
  410.     If OldAge > MaxAge Then
  411.       Print P4;OldAge;P1;" Day(s)"
  412.     Else
  413.       Print P2;OldAge;P1;" Days(s)"
  414.     End If
  415.     CLREOL
  416.   End If 'Done Checking for existing packet.
  417.   FindQWK = FindQWK + 1
  418. Loop 'Found one so go and look for another.
  419. Delay 3 '3 seconds delay for display effect only.
  420. Print
  421. If (QWKTotal < MaxPacket) and (Size < MaxSize) Then 'No age check 1st time.
  422.   ChaStr1 = QWKRoute + Str(UserRec.UserID) + ".QW" 'Partial NewFile var.
  423.   NewFile = ChaStr1 + Chr(QWKTotal + 65) 'Newfile variable.
  424.   OldFile = WCMailRoute + Str(UserRec.UserID) + ".QWK" 'OldFile Variable.
  425.   If Exists(OldFile) Then 'Get ready to relocate WCMAIL QWK Packet.
  426.     CopyFile(OldFile,NewFile) 'Copy WCMAIL QWK packet to storage.
  427.     ChaStr1 = Str(UserRec.UserId) + ".QWK"
  428.     DeleteFile(ChaStr1,WCMailZip,1) 'Delete old QWK file from disk & records.
  429.     QWKTotal = QWKTotal + 1'Increment total number of stored packets.
  430.     FindFirst(NewFile,0,FileSearch) 'Establish FileSearch variable.
  431.     FileSize=FileSearch.Size'Determine packet file size.
  432.     Size = Size + FileSearch.Size 'Increment size of stored packets.
  433.   End If 'WCMail Packet has been moved to storage.
  434. End If 'So much for existing packets when this program started.
  435. Do While (QWKTotal < MaxPacket) and (Size < MaxSize) and (OldAge < MaxAge)
  436.   CLS
  437.   ChaStr1 = "WCMAIL " + Trim(UserRec.Name) + " /PRESCAN" 'Shell Variables.
  438.   Shell ChaStr1 'Try and create a new QWK Packet.
  439.   If Exists(OldFile) Then 'Check to see if a new one was made.
  440.     ChaStr1 = QWKRoute + Str(UserRec.UserId) + ".QW" 'Partial NewFile.
  441.     NewFile = ChaStr1 + Chr(QWKTotal + 65) 'NewFile variable.
  442.     OldFile = WCMailRoute + Str(UserRec.UserID) + ".QWK" 'OldFile variable.
  443.     CopyFile(OldFile,NewFile) 'Copy new QWK file to Storage.
  444.     ChaStr1 = Str(UserRec.UserID) + ".QWK" 'Load deletion variables.
  445.     DeleteFile(ChaStr1,WCMailZip,1) 'Remove QWK from Wildcat Files.
  446.     FindFirst(NewFile,0,FileSearch) 'Establish FileSearch variable.
  447.     ChaStr1 = "QWK2: " + UserRec.Name + " had the new packet moved to"
  448.     ChaStr1 = ChaStr1 + " storage location " + FileSearch.Name+ "."
  449.     ActivityLog ChaStr1
  450.     FileSize = FileSearch.Size 'Determine packet file size.
  451.     Size = Size + FileSearch.Size 'Increment size of stored packets.
  452.     QWKTotal = QWKTotal + 1 'Increment total number of user stored QWK's.
  453.   ELSE
  454.     Exit Do: Return'Quit this Do Loop early.
  455.   End If 'A new packet was made and placed into storage.
  456. Loop 'If room and mail still not all packetized make another packet.
  457. Print P1;"QWK2: ";P3;UserRec.Name;P1;" Finished checking and or making packets.":Delay 3
  458. 'Check packets for expiration date, advise of exceeded values if needed.
  459. 'Update user record with QWKTotal and QWK2 to OFF if needed.
  460. If UserOnline = True Then Return 'User Is online, so skip subroutine.
  461. Print P1;"QWK2: ";P3;UserRec.Name;P1;" Checking for any exceeded limits.":Delay 2
  462.   NumInt2 = Val(Mid(QWKFlag,9,1))
  463.   ChaStr1 = Pad(UCase(Left(UserRec.Comment(NumInt2),9)),9)'Load QWK ON/OFF.
  464.   UserRec.Comment(Val(Mid(QWKFlag,9,1))) = ChaStr1 'Load Values.
  465. If QWKTotal >= MaxPacket Then 'Too many packets exist for user.
  466.   ChaStr1 = "QWK2: " + UserRec.Name + " has reached the QWK2 MaxPacket limit of "
  467.   ChaStr1 = ChaStr1 + Str(MaxPacket) + "."
  468.   ActivityLog ChaStr1 'Make the log entry.
  469. End If
  470.  
  471. If Size >= MaxSize Then 'Too much storage space in use by user.
  472.   ChaStr1 = "QWK2: " + UserRec.Name + " has exceeded the QWK2 MaxSize limit of "
  473.   ChaStr1 = ChaStr1 + Str(MaxSize) + "."
  474.   ActivityLog ChaStr1 'Make the log entry.
  475. End If
  476.  
  477. If OldAge >= MaxAge Then 'Stored packet exceeds MaxAge limit.
  478.   ChaStr1 = "QWK2: " + UserRec.Name + " has QWK2 packet(s) that reached the "
  479.   ChaStr1 = ChaStr1 +  "old age of " + Str(MaxAge) + " days."
  480.   ActivityLog ChaStr1 'Make 1st part of log entry.
  481.   ChaStr1 = "QWK2: " + UserRec.Name + " had the Automated QWK option turned off."
  482.   ActivityLog ChaStr1 'Make 2nd part of log entry.
  483.   UserRec.Comment(Val(Mid(QWKFlag,9,1))) = "QWK2 OFF " 'Load Values.
  484.   'Send message notifying user the warning message.
  485.   ChaStr2 = Chr(13) + Chr(13)
  486.   ChaStr1 = "This is an automated message." + ChaStr2
  487.   ChaStr1 = ChaStr1 + "The automatic mail packets you requested are not" + \
  488.     " being picked up."  + ChaStr2
  489.   ChaStr1 = ChaStr1 + "This option has been turned off and packets found" + \
  490.     " after 15 days will be deleted."
  491.   If Exists(ProgPath + "QWK2WARN.TXT") Then 'Check for existance of text msg.
  492.     ChaStr1 = ProgPath +"QWK2WARN.TXT" 'Replace above default message.
  493.   End If' Done with warning message checking.
  494.   MsgHd.To = UserRec.Name 'User to send message to.
  495.   MsgHd.From = MakeWild.SysopName 'Tell user message is from sysop.
  496.   FlagSet(MsgHd.Flags, &H01)' Set message flag on.
  497.   FlagSet(MsgHd.Flags, &H02)' Set message flag on.
  498.   MsgHd.Subject = "QWK Age Limit"
  499.   AddMessage(MsgHd, ChaStr1, , MsgPlace)
  500.   ChaStr2 = P1 + "QWK2: " + P3 + UserRec.Name + P1 + " was sent a message advising of old mail."
  501.   ActivityLog ChaStr2 'Make the log entry.
  502. End If 'Done with Old date checking.
  503. UpdateUser(UserRec) 'Make actual User Record update now.
  504. Print P1;"QWK2: ";P3;UserRec.Name;P1;" Finished checking limits.": Delay 3
  505. Return 'Proper end of MainProg1
  506. '>>>----> End of MainProg1
  507.  
  508. '>>>----> Start of CleanOut
  509. CleanOut: 'Used to delete packets that are over expiration date.
  510. Print P1;"QWK2: Checking for any expired packets.":Delay 3
  511. ChaStr1 = QWKRoute +  "*.QW?" 'Set file spec we want to verify age of.
  512. NumInt2 = FindFirst(ChaStr1,0,FileSearch) 'Get file information.
  513. CLS
  514. MorePrompt Off
  515. Locate 8,1
  516. Print P1;"Deleting any QWK2 Packets over ";P2;MaxAge + 15;P1;" days old."
  517. Locate 10,1
  518. Print P1;"     FileName   AGE         Size"
  519. Do While NumInt2 = 0 'Setup loop
  520.   Locate 12,1
  521.   CLREOL
  522.   Print P1;LeftPad(FileSearch.Name,12);
  523.   If (CurDate - FileSearch.DosDate) > MaxAge Then
  524.     Print P4;
  525.   Else
  526.     Print P2;
  527.   End If
  528.   Print LeftPad(Str(CurDate - FileSearch.DosDate),7);
  529.   Print P3;LeftPad(Str(FileSearch.Size),14)
  530.   If (CurDate - FileSearch.DosDate) > MaxAge Then
  531.     Delay 4
  532.   Else
  533.     Delay .2
  534.   End If
  535.   If CurDate - FileSearch.DosDate > MaxAge + 15 Then 'What age to kill.
  536.     NewFile = LeftPad(FileSearch.Name,12)
  537.     FOR NumInt1 = 1 to 26 'Setup to check all possible 26 packets per user.
  538.     ChaStr2 = Trim(Left(NewFile,8)) + ".QW" + Chr(64 + NumInt1)
  539.     OldFile = QWKRoute + ChaStr2
  540.     If Exists(OldFile) then 'Check to see if a old file exists.
  541.       Locate 6,1
  542.       Print P1;"Last expired QWK Packet."
  543.       CLREOL
  544.       Print P2;ChaStr2;P4;"  has expired and was removed.": Delay 3
  545.       Del OldFile 'Terminate old Packets.
  546.       ChaStr1 = "QWK2: Deleted expired packet " + ChaStr2 + "."
  547.       ActivityLog ChaStr1 'Log deleted file.
  548.     End If 'End If Exists check.
  549.     Next NumInt1 'Get next one of 26 possible per user account.
  550.   End If 'End of date check.
  551.   NumInt2 = FindNext(FileSearch) 'Check to see if we are out of files.
  552. Loop 'Go back and continue loop
  553. Print:Print P1;"Finished checking for Expired packets.":Delay 3
  554. Return 'Proper end of CleanOut subroutine.
  555. '>>>----> End of CleanOut
  556.  
  557.  
  558. '>>>----> Start of Problem Goto
  559. Problem: 'Come here if there is a drop dead error needing sysop attention.
  560. CLS: Print
  561. If BadEnd = 0  Then
  562.   Print P4;"Your QWK2HOLD.CFG file was not located." 'Where is it.
  563. End If 'End Error #0.
  564. 'Reserve BadEnd 1 - 20 for .CFG file checking
  565. If BadEnd >= 1 and BadEnd <=10 Then 'Something wrong with configuation file.
  566.   Print P1;"Line #";P2;BadEnd;P1;" of the QWK2HOLD.CFG has a problem." 'What line is bad.
  567. End If 'End Error #1 - 20.
  568.   Print
  569.   Print P1;"The current values of your ";P2;"QWK2HOLD.CFG";P1;" file are";P2;":"
  570.   Print P1;"Line  #1 = [";P2;WCMailRoute;P1;"]"
  571.   Print P1;"Line  #2 = [";P2;WCMailZip;P1;"]"
  572.   Print P1;"Line  #3 = [";P2;QWKRoute;P1;"]"
  573.   Print P1;"Line  #4 = [";P2;QWKFlag;P1;"]"
  574.   Print P1;"Line  #5 = [";P2;SecPro1;P1;"]"
  575.   Print P1;"Line  #6 = [";P2;SecPro2;P1;"]"
  576.   Print P1;"Line  #7 = [";P2;MaxPacket;P1;"]"
  577.   Print P1;"Line  #8 = [";P2;MaxAge;P1;"]"
  578.   Print P1;"Line  #9 = [";P2;MaxSize;P1;"]"
  579.   Print P1;"Line #10 = [";P2;MsgPlace;P1;"]"
  580.   Print P1;"Line #11 = [";P2;Mid(P1,2,2);P1;"]"
  581.   Print P1;"Line #12 = [";P2;Mid(P2,2,2);P1;"]"
  582.   Print P1;"Line #13 = [";P2;Mid(P3,2,2);P1;"]"
  583.   Print P1;"Line #14 = [";P2;Mid(P4,2,2);P1;"]"
  584.   Print P1;"Line #15 = [";P2;QWKInbound;P1;"]"
  585.   Print
  586. WaitEnter
  587. ChaStr2 = "QWK2 Ended with on an error of some kind"
  588. Print: Print ChaStr2
  589. ActivityLog ChaStr2
  590. ChaStr2 = "Check line #"+ Str(BadEnd) + " of the QWK2HOLD.CFG."
  591. Print: Print Chastr2
  592. ActivityLog ChaStr2
  593. End' End here if program ends in an error.
  594. '>>>----> End of Problem Goto.